home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / gfx / show / gs503_data.lha / Ghostscript / data / gs_setpd.ps < prev    next >
Text File  |  1997-08-14  |  22KB  |  683 lines
  1. %    Copyright (C) 1994, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % The current implementation of setpagedevice has the following limitations:
  19. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  20.  
  21. languagelevel 1 .setlanguagelevel
  22. level2dict begin
  23.  
  24. % ---------------- Redefinitions ---------------- %
  25.  
  26. % Redefine .beginpage and .endpage so that they call BeginPage and
  27. % EndPage respectively if appropriate.
  28.  
  29. % We have to guard against the BeginPage procedure not popping its operand.
  30. % This is really stupid, but the Genoa CET does it.
  31. /.beginpage        % - .beginpage -
  32.  { .currentshowpagecount
  33.     { .currentpagedevice pop /BeginPage .knownget
  34.        {    % Stack: ... pagecount proc
  35.      count 2 .execn
  36.         % Stack: ... ..???.. oldcount
  37.      count 1 add exch sub { pop } repeat
  38.        }
  39.        { pop
  40.        }
  41.       ifelse
  42.     }
  43.    if
  44.  } bind odef
  45.  
  46. % Guard similarly against EndPage not popping its operand.
  47. /.endpage        % <reason> .endpage <print_bool>
  48.  { .currentshowpagecount
  49.     { 1 index .currentpagedevice pop /EndPage .knownget
  50.        {    % Stack: ... reason pagecount reason proc
  51.      count 2 .execn
  52.         % Stack: ... ..???.. print oldcount
  53.      count 2 add exch sub { exch pop } repeat
  54.        }
  55.        { 2 ne
  56.        }
  57.       ifelse
  58.     }
  59.     { 2 ne
  60.     }
  61.    ifelse
  62.  } bind odef
  63.  
  64. % Define interpreter callouts for handling gstate-saving operators,
  65. % to make sure that they create a page device dictionary for use by
  66. % the corresponding gstate-restoring operator.
  67. % We'd really like to avoid the cost of doing this, but we don't see how.
  68. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  69. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  70. % interpreter.
  71.  
  72. (%gsavepagedevice) cvn
  73.  { currentpagedevice pop gsave
  74.  } bind def
  75.  
  76. (%savepagedevice) cvn
  77.  { currentpagedevice pop save
  78.  } bind def
  79.  
  80. (%gstatepagedevice) cvn
  81.  { currentpagedevice pop gstate
  82.  } bind def
  83.  
  84. (%copygstatepagedevice) cvn
  85.  { currentpagedevice pop copy
  86.  } bind def
  87.  
  88. (%currentgstatepagedevice) cvn
  89.  { currentpagedevice pop currentgstate
  90.  } bind def
  91.  
  92. % Define interpreter callouts for handling gstate-restoring operators
  93. % when the current page device needs to be changed.
  94. % The names %grestorepagedevice, %grestoreallpagedevice,
  95. % %restorepagedevice, and %setgstatepagedevice are known to the interpreter.
  96.  
  97. /.installpagedevice
  98.  {    % Since setpagedevice doesn't create new device objects,
  99.     % we must (carefully) reinstall the old parameters in
  100.     % the same device.
  101.    .currentpagedevice pop null currentdevice null .trysetparams
  102.    dup type /booleantype eq
  103.     { pop pop }
  104.     {        % This should never happen!
  105.       DEBUG { (Error in .trysetparams!\n) print pstack flush } if
  106.       cleartomark pop pop pop
  107.       /.installpagedevice cvx /rangecheck signalerror
  108.     }
  109.    ifelse pop pop
  110.    erasepage initgraphics .beginpage
  111.  } bind def
  112.  
  113. /.uninstallpagedevice
  114.  { 2 .endpage { .currentnumcopies false .outputpage } if
  115.    nulldevice
  116.  } bind def
  117.  
  118. (%grestorepagedevice) cvn
  119.  { .uninstallpagedevice grestore .installpagedevice
  120.  } bind def
  121.  
  122. (%grestoreallpagedevice) cvn
  123.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  124.  } bind def
  125.  
  126. (%restorepagedevice) cvn
  127.  { .uninstallpagedevice grestore .installpagedevice restore
  128.  } bind def
  129.  
  130. (%setgstatepagedevice) cvn
  131.  { .uninstallpagedevice setgstate .installpagedevice
  132.  } bind def
  133.  
  134. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  135. /.numcopiesdict mark
  136.   /NumCopies dup
  137. .dicttomark readonly def
  138.  
  139. /.currentnumcopies
  140.  { currentdevice //.numcopiesdict .getdeviceparams
  141.    dup type /integertype eq
  142.     { exch pop exch pop }
  143.     { cleartomark #copies }
  144.    ifelse
  145.  } bind odef
  146.  
  147. % ---------------- Auxiliary definitions ---------------- %
  148.  
  149. % Define the required attributes of all page devices, and their default values.
  150. % We don't include attributes such as .MediaSize, which all devices
  151. % are guaranteed to supply on their own.
  152. /.defaultpolicies mark
  153.   /PolicyNotFound 1
  154.   /PageSize 0
  155.   /PolicyReport {pop} bind
  156. .dicttomark readonly def
  157. /.requiredattrs mark
  158.   /PageOffset [0 0] readonly
  159. % We define InputAttributes and OutputAttributes with a single
  160. % dummy media type that handles pages of any size.
  161. % Devices that care will override this.
  162.   /InputAttributes mark 0
  163.     mark /PageSize [0 dup 16#7ffff dup] .dicttomark readonly
  164.   .dicttomark readonly
  165.   (%MediaSource) 0
  166.   /OutputAttributes mark 0
  167.     mark .dicttomark readonly
  168.   .dicttomark readonly
  169.   (%MediaDestination) 0
  170.   /Install {.callinstall} bind
  171.   /BeginPage {.callbeginpage} bind
  172.   /EndPage {.callendpage} bind
  173.   /Policies .defaultpolicies
  174. .dicttomark readonly def
  175.  
  176. % Define currentpagedevice so it creates the dictionary on demand if needed,
  177. % adding all the required entries defined just above.
  178. % We have to deal specially with entries that the driver may change
  179. % on its own.
  180. /.dynamicppkeys mark
  181.   /.MediaSize dup        % because it changes when PageSize is set
  182.   /PageCount dup
  183. .dicttomark readonly def
  184. /.makecurrentpagedevice        % - .makecurrentpagedevice <dict>
  185.  { currentdevice null .getdeviceparams
  186.     % In case of duplicate keys, .dicttomark takes the entry
  187.     % lower on the stack, so we can just append the defaults here.
  188.    .requiredattrs { } forall .dicttomark
  189.    dup .setpagedevice
  190.  } bind def
  191. /currentpagedevice
  192.  { .currentpagedevice
  193.     { dup length 0 eq
  194.        { pop .makecurrentpagedevice
  195.        }
  196.        {    % If any of the dynamic keys have changed,
  197.         % we must update the page device dictionary.
  198.      currentdevice //.dynamicppkeys .getdeviceparams .dicttomark
  199.       {    % Stack: current key value
  200.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  201.          { 2 index wcheck not
  202.         {    % This is the first entry being updated.
  203.             % Copy the dictionary to make it writable.
  204.           3 -1 roll dup length dict .copydict
  205.           3 1 roll
  206.         }
  207.            if
  208.            2 index 3 1 roll put
  209.          }
  210.          { pop pop
  211.          }
  212.         ifelse
  213.       }
  214.      forall
  215.         % We would like to do a .setpagedevice so we don't keep
  216.         % re-creating the dictionary.  Unfortunately, the effect
  217.         % of this is that if any dynamic key changes (PageCount
  218.         % in particular), we will do the equivalent of a
  219.         % setpagedevice at the next restore or grestore.
  220.         % Therefore, we make the dictionary read-only, but
  221.         % we don't store it away.  I.e., NOT:
  222.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  223.      readonly
  224.        }
  225.       ifelse
  226.     }
  227.    if
  228.  } bind odef
  229.  
  230. % The implementation of setpagedevice is quite complex.  Currently,
  231. % everything but the media matching algorithm is implemented here.
  232.  
  233. % By default, we only present the requested changes to the device,
  234. % but there are some parameters that require special merging action.
  235. % Define those parameters here, with the procedures that do the merging.
  236. % The procedures are called as follows:
  237. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  238. /.mergespecial mark
  239.   /InputAttributes
  240.    { dup null eq
  241.       { pop null
  242.       }
  243.       { 3 copy pop .knownget
  244.      { dup null eq
  245.         { pop dup length dict }
  246.         { dup length 2 index length add dict .copydict }
  247.        ifelse
  248.      }
  249.      { dup length dict
  250.      }
  251.         ifelse .copydict readonly
  252.       }
  253.      ifelse
  254.    } bind
  255.   /OutputAttributes 1 index
  256.   /Policies
  257.     { 3 copy pop .knownget
  258.        { dup length 2 index length add dict .copydict }
  259.        { dup length dict }
  260.       ifelse copy readonly
  261.     } bind
  262. .dicttomark readonly def
  263.  
  264. % Define the keys used in input attribute matching.
  265. /.inputattrkeys [
  266.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  267.     % The following are documented in Adobe's supplement for v2017.
  268.   /LeadingEdge /MediaClass
  269. ] readonly def
  270. % Define other keys used in media selection.
  271. /.inputselectionkeys [
  272.   /MediaPosition /Orientation
  273. ] readonly def
  274.  
  275. % Define the keys used in output attribute matching.
  276. /.outputattrkeys [
  277.   /OutputType
  278. ] readonly def
  279.  
  280. % Define all the parameters that should always be copied to the merged
  281. % dictionary.
  282. /.copiedkeys [
  283.   /OutputDevice
  284.   .mergespecial { pop } forall
  285.   .inputattrkeys aload pop
  286.   .inputselectionkeys aload pop
  287.   .outputattrkeys aload pop
  288. ] readonly def
  289.  
  290. % Define the parameters that should not be presented to the device.
  291. % The procedures are called as follows:
  292. %    <merged> <key> <value> -proc-
  293. % The procedure leaves all its operands on the stack and returns
  294. % true iff the key/value pair should be presented to .putdeviceparams.
  295. /.presentspecial mark
  296.   .dynamicppkeys { pop false } forall
  297.             % We must ignore an explicit request for .MediaSize,
  298.             % because media matching always handles this.
  299.   /.MediaSize false
  300.   /Name false
  301.   /OutputDevice false
  302.   /PageOffset false
  303.   /PageSize false        % obsolete alias for .MediaSize
  304.   /InputAttributes false
  305.   .inputattrkeys
  306.     { dup /PageSize eq
  307.        { pop }
  308.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  309.       ifelse
  310.     }
  311.   forall
  312.   .inputselectionkeys { false } forall
  313.   /OutputAttributes false
  314.   .outputattrkeys
  315.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  316.   forall
  317.   /Install false
  318.   /BeginPage false
  319.   /EndPage false
  320.   /Policies false
  321.     % Our extensions:
  322.   /HWColorMap
  323.     {            % HACK: don't transmit the color map, because
  324.             % window systems can change the color map on their own
  325.             % incrementally.  Someday we'll have a better
  326.             % solution for this....
  327.       false
  328.     }
  329.   /ViewerPreProcess false
  330. .dicttomark readonly def
  331.  
  332. % Define access to device defaults.
  333. /.defaultdeviceparams
  334.  { finddevice null .getdeviceparams
  335.  } bind def
  336.  
  337. % Select media (input or output).  The hard work is done in an operator:
  338. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  339. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  340. %    <pagedict> null <policydict> <keys> .matchmedia null true
  341. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  342.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  343.             %   .selectmedia
  344.  { 5 index 5 -2 roll 4 index .matchmedia
  345.         % Stack: orig request merged failed attrkeys mediakey
  346.         %   (key true | false)
  347.     { 4 index 3 1 roll put pop
  348.     }
  349.     {    % Adobe's implementations have a "big hairy heuristic"
  350.     % to choose the set of keys to report as having failed the match.
  351.     % For the moment, we report any keys that are in the request
  352.     % and don't have the same value as in the original dictionary.
  353.       5 index 1 index .knownget
  354.        { 4 index 3 1 roll put }
  355.        { 3 index exch .undef }
  356.       ifelse
  357.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  358.      3 index 1 index .knownget
  359.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  360.       { true }
  361.      ifelse        % Stack: ... <failed> <attrkey> <report>
  362.       { 2 copy /rangecheck put }
  363.      if pop
  364.        }
  365.       forall
  366.     }
  367.    ifelse
  368.  } bind def
  369.  
  370. % Apply Policies to any unprocessed failed requests.
  371. % As we process each request entry, we replace the error name
  372. % in the <failed> dictionary with the policy value,
  373. % and we replace the key in the <merged> dictionary with its prior value
  374. % (or remove it if it had no prior value).
  375. /.policyprocs mark
  376. % These procedures are called with the following on the stack:
  377. %   <orig> <merged> <failed> <Policies> <key> <policy>
  378. % They are expected to consume the top 2 operands.
  379. % NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
  380. % the same as 0, i.e., we signal an error.
  381.   0 {        % Set errorinfo and signal a configurationerror.
  382.     pop dup 4 index exch get 2 array astore
  383.     $error /errorinfo 3 -1 roll put
  384.     cleartomark
  385.     /setpagedevice load /configurationerror signalerror
  386.   } bind
  387.   1 {        % Roll back the failed request to its previous status.
  388. DEBUG { (Rolling back.\n) print pstack flush } if
  389.     3 index 2 index 3 -1 roll put
  390.     4 index 1 index .knownget
  391.      { 4 index 3 1 roll put }
  392.      { 3 index exch .undef }
  393.     ifelse
  394.   } bind
  395.   7 {        % For PageSize only, just impose the request.
  396.     1 index /PageSize eq
  397.      { pop pop 1 index /PageSize 7 put }
  398.      { .policyprocs 0 get exec }
  399.     ifelse
  400.   } bind
  401. .dicttomark readonly def
  402. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  403.             %   <orig> <merged'> <failed'>
  404.  { 1 index /Policies get 1 index
  405.     { type /integertype eq
  406.        { pop        % already processed
  407.        }
  408.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  409.             % Stack: <orig> <merged> <failed> <Policies> <key>
  410.             %   <policy>
  411.      .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
  412.        }
  413.       ifelse
  414.     }
  415.    forall pop
  416.  } bind def
  417.  
  418. % Prepare to present parameters to the device, by spreading them onto the
  419. % operand stack and removing any that shouldn't be presented.
  420. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  421.  { mark exch dup
  422.     {            % Stack: -mark- key1 value1 ... merged key value
  423.       .presentspecial 2 index .knownget
  424.        { exec { 3 -1 roll } { pop pop } ifelse }
  425.        { 3 -1 roll }
  426.       ifelse
  427.     }
  428.    forall pop
  429.  } bind def
  430.  
  431. % Put device parameters without resetting currentpagedevice.
  432. % (.putdeviceparams clears the current page device.)
  433. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  434.             %   <key1> <value1> ... .putdeviceparamsonly
  435.             % On success: <device> <eraseflag>
  436.             % On failure: <device> <Policies|null> <req_all> -mark-
  437.             %   <key1> <error1> ...
  438.  { .currentpagedevice
  439.     { counttomark 4 add 1 roll .putdeviceparams
  440.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  441.       .setpagedevice
  442.     }
  443.     { pop .putdeviceparams
  444.     }
  445.    ifelse
  446.  } bind def
  447.  
  448. % Try setting the device parameters from the merged request.
  449. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  450.             %   .trysetparams
  451.  { true 4 index .prepareparams
  452.             % Add the computed .MediaSize.
  453.             % Stack: merged (ignored) device Policies -true-
  454.             %   -mark- key1 value1 ...
  455.    counttomark 5 add index .computemediasize
  456.    exch pop exch pop /.MediaSize exch
  457. DEBUG { (Putting.\n) print pstack flush } if
  458.    .putdeviceparamsonly
  459. DEBUG { (Result of putting.\n) print pstack flush } if
  460.  } bind def
  461.  
  462. % Compute the media size and initial matrix from a merged request (after
  463. % media selection).
  464. /.computemediasize    % <request> .computemediasize
  465.             %   <request> <matrix> <[width height]>
  466.  { dup /PageSize get                    % requested page size
  467.    1 index /InputAttributes get
  468.      2 index (%MediaSource) get get /PageSize get    % media size
  469.                             % (may be a range)
  470.    2 index /Policies get
  471.      dup /PageSize .knownget
  472.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  473.                             % affects scaling
  474.    3 index /Orientation .knownget not { null } if
  475.    4 index /RollFedMedia .knownget not { false } if
  476.    matrix .matchpagesize pop        % (can't fail)
  477.    2 array astore
  478.  } bind def
  479.  
  480. % ---------------- setpagedevice itself ---------------- %
  481.  
  482. /setpagedevice
  483.  { mark exch currentpagedevice
  484.  
  485.         % Check whether we are changing OutputDevice;
  486.         % also handle the case where the current device
  487.         % is not a page device.
  488.         % Stack: mark <request> <current>
  489. DEBUG { (Checking.\n) print pstack flush } if
  490.  
  491.    dup /OutputDevice .knownget
  492.     {        % Current device is a page device.
  493.       2 index /OutputDevice .knownget
  494.        {    % A specific OutputDevice was requested.
  495.      2 copy eq
  496.       { pop pop null }
  497.       { exch pop }
  498.      ifelse
  499.        }
  500.        { pop null
  501.        }
  502.       ifelse
  503.     }
  504.     {        % Current device is not a page device.
  505.         % Use the default device.
  506.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  507.     }
  508.    ifelse
  509.    dup null eq
  510.     { pop
  511.     }
  512.     { exch pop .defaultdeviceparams
  513.         % In case of duplicate keys, .dicttomark takes the entry
  514.         % lower on the stack, so we can just append the defaults here.
  515.       .requiredattrs { } forall .dicttomark
  516.     }
  517.    ifelse
  518.  
  519.         % Check whether a viewer wants to intervene.
  520.         % We must check both the request (which takes precedence)
  521.         % and the current dictionary.
  522.         % Stack: mark <request> <orig>
  523.    exch dup /ViewerPreProcess .knownget
  524.     { exec }
  525.     { 1 index /ViewerPreProcess .knownget { exec } if }
  526.    ifelse exch
  527.  
  528.         % Construct a merged request from the actual request plus
  529.         % any keys that should always be propagated.
  530.         % Stack: mark <request> <orig>
  531. DEBUG { (Merging.\n) print pstack flush } if
  532.  
  533.    exch 1 index length 1 index length add dict
  534.    .copiedkeys
  535.     {        % Stack: <orig> <request> <merged> <key>
  536.       3 index 1 index .knownget { 3 copy put pop } if pop
  537.     }
  538.    forall
  539.         % Stack: <orig> <request> <merged>
  540.    dup 2 index
  541.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  542.       .mergespecial 2 index .knownget { exec } if
  543.       put dup
  544.     }
  545.    forall pop
  546.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  547.         % change HWResolution.
  548.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  549.         % Hack: if FIXEDMEDIA is true, discard any attempt to change
  550.         % PageSize or HWSize.
  551.    FIXEDMEDIA
  552.     { dup /PageSize 4 index /PageSize get put
  553.       dup /HWSize 4 index /HWSize get put
  554.     } if
  555.  
  556.         % Select input and output media.
  557.         % Stack: mark <orig> <request> <merged>
  558. DEBUG { (Selecting.\n) print pstack flush } if
  559.  
  560.    0 dict    % <failed>
  561.    1 index /InputAttributes .knownget
  562.     { 2 index /Policies get
  563.       .inputattrkeys (%MediaSource) cvn .selectmedia
  564.     } if
  565.    1 index /OutputAttributes .knownget
  566.     { 2 index /Policies get
  567.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  568.      } if
  569.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  570.    .applypolicies
  571.    3 -1 roll 4 1 roll        % swap back
  572.  
  573.         % Construct the new device, and attempt to set its attributes.
  574.         % Stack: mark <orig> <request> <merged> <failed>
  575. DEBUG { (Constructing.\n) print pstack flush } if
  576.  
  577.    currentdevice .devicename 2 index /OutputDevice get eq
  578.     { currentdevice }
  579.     { 1 index /OutputDevice get finddevice }
  580.    ifelse
  581.         %**************** We should copy the device here,
  582.         %**************** but since we can't close the old device,
  583.         %**************** we don't.  This is WRONG.
  584.     %****************copydevice
  585.    2 index /Policies get
  586.    .trysetparams
  587.    dup type /booleantype ne
  588.     {        % The request failed.
  589.         % Stack: ... <orig> <request> <merged> <failed> <device>
  590.         %   <Policies> true mark <name> <errorname> ...
  591. DEBUG { (Recovering.\n) print pstack flush } if
  592.       counttomark 4 add index
  593.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  594.       pop pop pop
  595.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  596.         %   <Policies>
  597.       6 2 roll 3 -1 roll 4 1 roll
  598.       .applypolicies
  599.       3 -1 roll 4 1 roll 6 -2 roll
  600.       .trysetparams        % shouldn't fail!
  601.       dup type /booleantype ne
  602.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  603.          /setpagedevice load exch signalerror
  604.        }
  605.       if
  606.     }
  607.    if
  608.  
  609.         % The attempt succeeded.  Install the new device.
  610.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  611. DEBUG { (Installing.\n) print pstack flush } if
  612.  
  613.    pop 2 .endpage
  614.     { 1 true .outputpage
  615.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  616.     }
  617.    if
  618.         % .setdevice clears the current page device!
  619.    .currentpagedevice pop exch
  620.    .setdevice pop
  621.    .setpagedevice
  622.  
  623.         % Merge the request into the current page device.
  624.         % Stack: mark ... <merged> <failed>
  625.    exch currentpagedevice dup length 2 index length add dict
  626.    .copydict .copydict
  627.         % Initialize the default matrix, taking media matching
  628.         % into account.
  629.    .computemediasize pop initmatrix concat
  630.    dup /PageOffset .knownget
  631.     {        % Translate by the given number of 1/72" units in device X/Y.
  632.       dup 0 get exch 1 get
  633.       2 index /HWResolution get dup 1 get exch 0 get
  634.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  635.       idtransform translate
  636.     }
  637.    if
  638.         % We must install the new page device dictionary
  639.         % before calling the Install procedure.
  640.    dup .setpagedevice
  641.    .setdefaultscreen    % Set the default screen before calling Install.
  642.    dup /Install .knownget { exec } if
  643.    matrix currentmatrix .setdefaultmatrix
  644.         % Erase and initialize the page.
  645.    erasepage initgraphics
  646.    .beginpage
  647.  
  648.         % Clean up, calling PolicyReport if needed.
  649.         % Stack: mark ... <failed> <merged>
  650. DEBUG { (Finishing.\n) print pstack flush } if
  651.  
  652.    exch dup length 0 ne
  653.     { 1 index /Policies get /PolicyReport get
  654.       counttomark 1 add 2 roll cleartomark
  655.       exec
  656.     }
  657.     { cleartomark
  658.     }
  659.    ifelse
  660.  
  661.  } odef
  662.  
  663. % We haven't yet updated setpagedevice to take advantage of the fact that
  664. % operators defined by procedures automatically restore the stack depth
  665. % if they fail.  The following patch handles this, and will even work on
  666. % older interpreters that don't restore the stack on failure.  Note that
  667. % this does *not* restore the previous page device in the case of late
  668. % errors such as an error in the Install procedure.
  669. /.dosetpagedevice /setpagedevice load def
  670. /setpagedevice
  671. { dup count 1 sub
  672.    { { .dosetpagedevice } stopped } aload pop
  673.   3 -1 roll 3 packedarray cvx exec
  674.     % Stack: <request> ... <stopped?> <count>
  675.   exch
  676.    { count exch sub 1 sub { pop } repeat stop }
  677.    { pop pop }
  678.   ifelse
  679. } odef
  680.  
  681. end                % level2dict
  682. .setlanguagelevel
  683.